home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0195.ZIP / EXTENDIO.LIB < prev    next >
Text File  |  1985-01-09  |  9KB  |  235 lines
  1. {@@@@@@@@@@@@@@@@@ copyright 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@
  2.  
  3. Standard TURBO procedures for input/output do not support subdirectories.
  4.  
  5. XSeek repaired 1/9/85 to take care of problem with LARGE files
  6.  
  7. These file handling procedures are based on the DOS 2.0 "file handle" access
  8. concept.  They are named after their standard TURBO equivalents, but with
  9. an X in front.  Note that these files are not "typed"--they are just files
  10. of bytes.  The "SIZE" parameter determines how many bytes are read at once.
  11.  
  12.     NOTE that any program that INCLUDEs these Extended I/O routines MUST
  13.     also include the type definitions in REGPACK.TYP and FILENAME.TYP,
  14.     and ERRMESSG.LIB, to interpret any error messages.
  15.  
  16.  
  17. Xreset(VAR FileName : filename_type; VAR handle : integer; VAR error : byte);
  18.     NOTE: for a simple reset of an already-open file, use XSeek.
  19. Xrewrite(VAR FileName : filename_type; VAR handle : integer; VAR error:byte);
  20.     INPUT  : a filename, including full path.
  21.     EFFECT : XRESET opens an already-existing file
  22.              XREWRITE opens a new file, or writes over an existing file
  23.     OUTPUT : an integer FILE HANDLE or a byte ERROR.
  24.  
  25.  
  26. Xclose(handle : integer ; VAR error : byte);
  27.     INPUT  : integer FILE HANDLE
  28.     EFFECT : flushes buffers and closes the file
  29.     OUTPUT : error #6 if handle is wrong
  30.  
  31. Xread(handle,size : integer ; VAR buffer ; VAR error : byte);
  32. Xwrite(handle,size : integer ; VAR buffer ; VAR error : byte);
  33.     INPUT  : integer FILE HANDLE
  34.              integer SIZE of buffer variable.  You can pass this using TURBO's
  35.              builtin SIZEOF(x) function, where x is a variable OR a TYPE.
  36.     EFFECT : reads into or writes from the buffer.
  37.     OUTPUT : byte error message
  38.  
  39. Xerase(VAR filename : filename_type ; VAR error : byte);
  40.     INPUT  : filename, including drive and full path
  41.     EFFECT : erases the named filename
  42.     OUTPUT : byte error message
  43.  
  44. Xseek(handle, offset,size : integer ;  starting_at  : char;
  45.         VAR position : integer ;  VAR error    : byte);
  46.     INPUT  : integer FILE HANDLE
  47.              integer OFFSET--how far to seek forward, in # of records
  48.              integer SIZE of each record
  49.              character STARTING_AT: [B]eginning, [E]nd, or [C]urrent position
  50.     EFFECT : moves the file pointer to a position OFFSET*SIZE bytes after
  51.              the position defined by STARTING_AT.
  52.     OUTPUT : integer POSITION--position of file pointer in # of records after
  53.              the move.
  54.              byte ERROR message.
  55.     NOTES  : OFFSET and POSITION both have the potential to be 32-bit
  56.              quantities, but since TURBO doesn't handle even true 16-bit
  57.              quantities easily, I didn't implement this possibility.  It is
  58.              probably safe to assume that if you want BIG access to BIG files,
  59.              your record size will be such that you won't have more than
  60.              32,767 records.
  61.              To APPEND to a file, XSEEK Starting_At the [E]nd for an OFFSET
  62.              of 1, SIZE of 1.  You'll need a dummy variable for the returned
  63.              POSITION.}
  64. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  65.  
  66. var
  67.   registers : regpack;
  68.  
  69. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  70. procedure Xreset(VAR FileName : filename_type;
  71.                     VAR handle:integer;
  72.                     VAR error : byte);
  73.  
  74. begin                                  { The filename has to be in the form  }
  75.   FileName[length(FileName)+1] := #0;  { of an "ASCIIZ" (ASCII+zero) string, }
  76.   with registers do                        { so we add a chr(0) to the end.  This}
  77.     begin                              { function is not interested in the   }
  78.       DS := seg(FileName);             { LENGTH byte of the string,so we give}
  79.       DX := ofs(FileName)+1;           { OFFSET+1 as the starting address.   }
  80.                                {We need $3D in AH (the high byte of AX) and 2}
  81.       AX := $3D shl 8 + 2;     {in AL to select "open for reading & writing".}
  82.                                {"SHL" is SHift Left--shifting a byte 8 binary}
  83.                                {digits left makes it the high byte of an in- }
  84.                                {teger value.                                 }
  85.       MSDOS(registers);
  86.       if Flags and 1 = 1 then  {<< if the "carry flag" (the low bit of FLAGS)}
  87.                                {is set to one, that means an error message is}
  88.                                {being passed in AX                           }
  89.         error := AX and $00FF  {<-- Since the messages are "byte-sized", we  }
  90.                                {can safely mask off the high byte of AX.     }
  91.       else
  92.         begin
  93.           handle := AX;
  94.           error  := 0;
  95.         end;
  96.     end;
  97. end;
  98. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  99. procedure Xclose(handle : integer; VAR error : byte);
  100. begin
  101.   with registers do
  102.     begin
  103.       BX := handle;
  104.       AX := $3E shl 8;
  105.       MSDOS(registers);
  106.       if Flags and 1 = 1 then
  107.         error := AX mod 256
  108.       else error := 0;
  109.     end;
  110. end;
  111. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  112. procedure Xwrite(handle, size : integer;
  113.                  VAR buffer ;  {the type of the data in file}
  114.                  VAR error : byte);
  115.  
  116. begin
  117.   with registers do
  118.     begin
  119.       AX := $40 shl 8;
  120.       BX := handle;
  121.       CX := Size;
  122.       DS := seg(buffer);
  123.       DX := ofs(buffer);
  124.       MSDOS(registers);
  125.       if Flags and 1 = 1 then
  126.         error := AX and $00FF
  127.       else
  128.         if AX <> Size then
  129.           error := AX and $00FF
  130.         else error := 0;
  131.     end;
  132. end;
  133. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  134. procedure Xread(handle, size : integer;
  135.                  VAR buffer ;  {the type of the data in file}
  136.                  VAR error : byte);
  137.  
  138. begin
  139.   with registers do
  140.     begin
  141.       AX := $3F shl 8;
  142.       BX := handle;
  143.       CX := Size;
  144.       DS := seg(buffer);
  145.       DX := ofs(buffer);
  146.       MSDOS(registers);
  147.       if Flags and 1 = 1 then
  148.         error := AX and $00FF
  149.       else
  150.         if AX <> Size then
  151.           error := 255
  152.         else error := 0;
  153.     end;
  154. end;
  155. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  156. procedure Xrewrite(VAR FileName : filename_type;
  157.                    VAR handle:integer;
  158.                    VAR error : byte);
  159. begin
  160.   FileName[length(FileName)+1] := #0;
  161.   with registers do
  162.     begin
  163.       DS := seg(FileName);
  164.       DX := ofs(FileName)+1;
  165.       CX := $20;  {archive}
  166.       AX := $3C shl 8;
  167.       MSDOS(registers);
  168.       if Flags and 1 = 1 then
  169.         error := AX and $00FF
  170.       else
  171.         begin
  172.           handle :=AX;
  173.           error := 0;
  174.         end;
  175.     end;
  176. end;
  177. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  178. procedure Xerase(VAR FileName : filename_type;
  179.                     VAR error : byte);
  180. begin
  181.   FileName[length(FileName)+1] := #0;
  182.   with registers do
  183.     begin
  184.       DS := seg(FileName);
  185.       DX := ofs(FileName)+1;
  186.       AX := $41 shl 8;
  187.       MSDOS(registers);
  188.       if Flags and 1 = 1 then
  189.         error := AX and $00FF
  190.       else
  191.         begin
  192.           error := 0;
  193.         end;
  194.     end;
  195. end;
  196. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  197. procedure Xseek(handle, offset, size : integer ;  starting_at  : char;
  198.                         VAR position : integer ;  VAR error    : byte);
  199. const
  200.   HexTenThou : real = 65536.;
  201. var
  202.   method_value : byte;
  203.   MSInt, LSInt, tempPos : real;
  204. begin
  205.   case upCase(starting_at) of
  206.     'B': method_value := 0;   {starting at beginning}
  207.     'E': method_value := 2;   {starting at end}
  208.   else   method_value := 1;   {default is starting at current pos}
  209.   end;  {case}
  210.   with registers do
  211.     begin
  212.       AX := $42 shl 8 + method_value;
  213.       BX := handle;
  214.       CX := trunc(offset*size/HexTenThou);
  215.       DX := trunc(offset*size - CX);
  216.       MSDOS(registers);
  217.       if Flags and 1 = 1 then
  218.         error := AX
  219.       else
  220.         begin
  221.           error := 0;
  222.           { 1/9/85  Noted that must take care of the case of DX or AX
  223.             being greater than HexTenThou/2 and thus seeming negative }
  224.           if DX >= 0 then MSInt := DX
  225.             else MSInt := HexTenThou + DX;
  226.           if AX >= 0 then LSInt := AX
  227.             else LSInt := HexTenThou + AX;
  228.           tempPos  := (HexTenThou*MSInt + LSInt) / size;
  229.           if (tempPos >= -32768.0) and (tempPos <= 32767.0) then
  230.             if tempPos < 0 then position := trunc(HexTenThou + tempPos)
  231.               else position := trunc(tempPos)
  232.             else error := $FF;
  233.         end;
  234.     end;
  235. end;